Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

181

Games Picked

280

Number of predictions

62

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Baltimore Ravens Baltimore Ravens Yes 52 0.8387
2 San Francisco 49ers San Francisco 49ers Yes 49 0.7903
3 Detroit Lions Detroit Lions Yes 57 0.9194
4 Buffalo Bills Kansas City Chiefs No 22 0.3548

Individual Predictions

row

Individual Table

Individual Results
Week 20
Name Weekly # Correct Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5 Week 6 Week 7 Week 8 Week 9 Week 10 Week 11 Week 12 Week 13 Week 14 Week 15 Week 16 Week 17 Week 18 Week 19 Week 20
David Plate NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 4 1.00 1 1.0000 0.0500
Pamela Augustine NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 4 1.00 1 1.0000 0.0500
Stephen Woolwine 8 13 9 NA NA 9 NA 11 11 NA 10 12 9 NA NA 9 NA 12 4 4 1.00 13 0.6875 0.4469
Montee Brown 7 NA NA 9 9 11 6 12 11 8 10 12 8 6 11 10 10 9 2 4 1.00 18 0.6200 0.5580
PABLO BURGOSRAMOS 9 11 10 12 7 12 6 8 9 7 10 NA 8 3 12 10 11 9 3 4 1.00 19 0.6098 0.5793
Matthew Schultz 8 NA 10 8 9 9 6 10 11 8 9 12 5 NA NA NA 10 10 2 4 1.00 16 0.6037 0.4830
Shawn Carden 9 12 6 9 8 9 5 10 9 8 9 12 7 6 10 11 10 7 3 4 1.00 20 0.5857 0.5857
Kevin Kehoe 9 10 11 12 7 8 6 10 7 8 8 8 NA 6 9 8 12 9 3 4 1.00 19 0.5805 0.5515
Thomas Brenstuhl 10 NA 8 8 8 9 5 9 11 6 11 NA 8 5 11 NA NA 9 3 4 1.00 16 0.5787 0.4630
Steven Webster 8 8 6 8 9 8 6 10 10 8 10 NA 7 6 12 NA NA NA NA 4 1.00 15 0.5714 0.4286
Min Choi 6 7 9 11 7 10 5 13 7 5 NA NA NA NA NA NA NA NA 4 4 1.00 12 0.5570 0.3342
Rafael Torres 6 8 12 11 NA NA 6 NA 9 5 10 8 5 6 11 6 12 6 3 4 1.00 17 0.5447 0.4630
Robert Martin 10 9 6 NA 9 9 6 9 NA 5 9 9 6 8 9 7 NA 8 3 4 1.00 17 0.5385 0.4577
Trevor Macgavin NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 3 0.75 1 0.7500 0.0375
Justin Crick 11 11 11 13 8 11 4 11 11 8 9 12 9 8 11 9 11 9 3 3 0.75 20 0.6536 0.6536
Shelly Bailey 9 10 NA 10 8 11 6 NA 13 7 9 13 NA NA NA NA NA NA NA 3 0.75 11 0.6513 0.3582
William Schouviller 10 9 11 10 8 9 NA 13 10 9 9 10 10 6 11 10 12 10 3 3 0.75 19 0.6479 0.6155
George Sweet 9 11 10 12 7 10 10 NA 11 8 10 13 9 8 8 8 11 9 4 3 0.75 19 0.6477 0.6153
Ramar Williams NA 11 11 9 8 8 6 12 NA 8 NA 13 9 6 11 NA 13 9 4 3 0.75 16 0.6409 0.5127
Jason Schattel 7 10 9 11 9 10 3 13 12 9 10 12 9 6 10 11 NA 11 3 3 0.75 19 0.6364 0.6046
Antonio Mitchell 10 12 NA 11 10 10 5 12 9 NA 10 12 NA 6 8 10 10 9 4 3 0.75 17 0.6318 0.5370
Cheryl Brown 10 12 11 9 6 9 6 10 8 9 8 12 8 8 11 11 11 11 3 3 0.75 20 0.6286 0.6286
Anthony Bloss 8 10 11 12 10 10 5 9 9 8 9 11 10 6 11 9 13 10 2 3 0.75 20 0.6286 0.6286
Gabriel Quinones 9 11 12 12 6 9 6 11 NA 8 9 NA 9 8 9 10 NA 9 5 3 0.75 17 0.6239 0.5303
Stephen Bush 7 10 10 9 7 10 6 12 NA 5 10 11 8 8 11 9 14 11 4 3 0.75 19 0.6203 0.5893
Patrick Tynan 8 8 10 11 7 NA 5 11 10 7 11 13 8 5 12 10 12 9 4 3 0.75 19 0.6189 0.5880
Vincent Scannelli 11 11 8 11 7 NA 5 9 12 10 10 NA 8 6 NA 11 NA NA 2 3 0.75 15 0.6169 0.4627
Keithon Corpening 8 NA NA NA NA NA NA 11 12 9 8 10 6 8 12 9 10 8 NA 3 0.75 13 0.6129 0.3984
Cody Koerwitz 7 9 11 12 7 10 6 NA 9 9 10 10 9 6 13 NA NA 10 1 3 0.75 17 0.6121 0.5203
Brian Patterson 10 10 8 11 7 11 5 10 10 8 11 12 7 6 9 8 13 10 2 3 0.75 20 0.6107 0.6107
John Plaster 8 12 8 10 NA NA 6 9 7 10 9 7 8 8 10 10 12 13 3 3 0.75 18 0.6096 0.5486
Karen Coleman 7 10 NA 10 8 9 4 9 13 11 9 12 8 6 10 8 14 7 3 3 0.75 19 0.6053 0.5750
Michael Moss 10 NA 11 13 7 9 4 10 9 8 9 10 8 5 10 11 10 NA 2 3 0.75 18 0.6008 0.5407
Terry Hardison 10 10 9 11 7 9 4 11 9 10 9 11 8 7 11 8 11 7 3 3 0.75 20 0.6000 0.6000
Aubrey Conn 9 12 8 11 9 9 4 11 11 8 7 12 8 5 9 10 NA 9 3 3 0.75 19 0.5985 0.5686
Paul Presti 9 10 12 9 8 9 5 8 NA 9 9 NA 8 10 11 9 NA 8 3 3 0.75 17 0.5983 0.5086
Amy Asberry 8 9 10 9 9 8 5 10 6 9 7 10 9 7 12 11 12 10 3 3 0.75 20 0.5964 0.5964
Paul Shim 10 9 10 11 7 9 4 10 10 8 11 10 8 8 9 8 11 8 2 3 0.75 20 0.5929 0.5929
Daniel Major 8 13 6 7 8 11 7 11 NA NA 9 NA 7 NA NA NA NA 7 5 3 0.75 13 0.5896 0.3832
Daniel Baller 6 12 11 9 8 9 3 10 8 9 10 9 8 9 9 9 9 10 4 3 0.75 20 0.5893 0.5893
Brian Hollmann 8 13 8 9 8 9 6 13 8 8 8 12 6 5 11 10 8 9 2 3 0.75 20 0.5857 0.5857
Anthony Brinson 10 11 8 6 10 9 8 10 9 7 8 11 9 5 9 8 7 10 3 3 0.75 20 0.5750 0.5750
Daniel Kuehl 6 10 8 11 7 9 7 12 7 6 10 11 8 6 9 9 NA 9 3 3 0.75 19 0.5720 0.5434
George Mancini 7 12 10 10 9 10 6 NA 7 9 9 11 5 7 NA 10 7 6 1 3 0.75 18 0.5605 0.5045
Justin Thrift 9 8 9 8 9 7 5 11 7 6 10 NA 7 9 8 10 NA 8 2 3 0.75 18 0.5484 0.4936
Melissa Printup 8 NA 8 7 10 7 6 NA NA 5 9 9 NA 9 7 8 8 9 4 3 0.75 16 0.5294 0.4235
Ryan Shipley 3 8 7 6 6 7 5 10 9 6 9 NA 5 6 11 8 9 7 3 3 0.75 19 0.4848 0.4606
Ryan Cvik 11 11 9 13 6 10 8 8 6 8 10 10 8 9 9 9 11 8 5 2 0.50 20 0.6107 0.6107
James Tierney 9 10 NA 10 10 12 7 10 8 9 9 10 8 8 7 11 8 10 4 2 0.50 19 0.6090 0.5786
Eric Hahn 9 13 7 9 8 10 6 9 10 6 11 12 9 6 10 8 12 10 2 2 0.50 20 0.6036 0.6036
MICHAEL BRANSON 8 11 10 12 9 10 4 11 10 7 8 NA 10 9 8 8 NA 9 3 2 0.50 18 0.6008 0.5407
James Small 8 8 13 9 8 10 8 10 12 6 10 9 5 7 9 8 11 11 3 2 0.50 20 0.5964 0.5964
Jonathon Leslein 9 9 9 9 7 11 5 9 8 10 10 NA 9 5 10 9 10 13 2 2 0.50 19 0.5909 0.5614
Ronald Schmidt 11 13 11 8 8 11 5 9 8 8 7 NA 7 7 9 11 10 NA 1 2 0.50 18 0.5887 0.5298
Steven Curtis NA NA 11 7 8 10 6 7 8 7 7 11 7 8 11 11 NA NA 4 2 0.50 16 0.5787 0.4630
Kristen White 7 13 8 11 6 7 7 10 8 6 10 7 8 7 8 NA 13 8 2 2 0.50 19 0.5606 0.5326
Cherylynn Vidal 10 9 9 12 9 7 4 6 9 7 NA 9 6 5 9 10 NA 8 NA 2 0.50 17 0.5369 0.4564
Wayne Schofield NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 3 2 0.50 2 0.5000 0.0500
Bunnaro Sun 9 10 9 8 9 9 6 9 11 8 10 10 8 5 12 NA 9 10 3 1 0.25 19 0.5909 0.5614
Walter Archambo 7 10 10 11 7 9 5 9 12 NA 8 11 9 5 10 10 11 9 3 1 0.25 19 0.5902 0.5607
Derrick Elam NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 11 2 1 0.25 3 0.5385 0.0808
Thomas Mccoy NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 3 1 0.25 2 0.4000 0.0400
Michael Edmunds 10 12 10 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.00 4 0.6774 0.1355
Kevin O'NEILL 8 11 11 13 7 NA NA 10 NA NA NA NA NA NA NA NA NA NA NA NA 0.00 6 0.6522 0.1957
Chris Papageorge 11 11 11 10 8 9 5 11 12 8 8 NA 10 NA 10 9 NA 9 NA NA 0.00 15 0.6368 0.4776
Ryan Wiggins 8 11 11 12 7 11 5 11 10 8 10 10 7 6 12 10 NA 12 3 NA 0.00 18 0.6308 0.5677
Sarah Sweet 9 12 12 9 8 NA 6 11 11 10 8 9 6 NA NA NA NA NA NA NA 0.00 12 0.6307 0.3784
Daniel Halse 8 9 10 NA NA NA 7 11 NA 7 7 NA 8 NA 11 10 13 12 NA NA 0.00 12 0.6278 0.3767
Carlos Caceres 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.00 1 0.6250 0.0312
Bradley Hobson 8 10 11 12 8 11 4 NA 8 9 9 12 NA 6 10 NA 11 NA 4 NA 0.00 15 0.6186 0.4640
Shaun Dahl 8 8 10 10 7 9 5 13 9 8 NA NA 8 8 13 11 NA 10 4 NA 0.00 16 0.6130 0.4904
DAVID PLATE 8 NA 8 9 8 10 5 9 11 8 9 12 NA 7 13 NA 11 9 4 NA 0.00 16 0.6104 0.4883
WAYNE SCHOFIELD 12 9 7 NA 8 NA 5 10 7 NA 10 NA 8 8 12 NA NA 12 NA NA 0.00 12 0.6102 0.3661
Donald Park 8 12 7 9 NA NA 6 10 11 NA 9 NA NA NA NA NA NA NA NA NA 0.00 8 0.6050 0.2420
Yiming Hu 9 10 8 12 7 9 6 9 10 8 10 NA 7 6 9 9 12 10 NA NA 0.00 17 0.5945 0.5053
James Blejski 8 11 10 14 NA 9 7 12 7 6 9 9 9 6 7 9 NA NA NA NA 0.00 15 0.5938 0.4454
Pamela AUGUSTINE 11 13 6 9 6 9 5 10 9 NA 10 11 8 6 11 9 NA NA NA NA 0.00 15 0.5938 0.4454
Earl Dixon 9 11 8 12 5 NA 7 8 9 8 9 12 8 6 11 10 NA 9 3 NA 0.00 17 0.5918 0.5030
Robert Gelo 6 9 10 10 9 11 5 11 6 9 9 10 8 6 11 NA NA NA 3 NA 0.00 16 0.5833 0.4666
William Sherman 8 11 10 10 6 NA 5 NA 9 NA 9 NA NA NA NA NA NA NA NA NA 0.00 8 0.5812 0.2325
Charlene Redmer 9 9 NA 9 9 11 NA 10 8 7 8 NA 6 NA NA 10 NA 9 3 NA 0.00 13 0.5806 0.3774
Brandon Parks 8 8 NA NA 9 9 5 9 9 9 8 10 10 10 9 9 NA 8 NA NA 0.00 15 0.5804 0.4353
Rahmatullah Sharifi 11 9 8 11 8 8 5 NA NA NA NA NA NA NA NA NA NA NA NA NA 0.00 7 0.5769 0.2019
Manuel Vargas 10 9 11 12 7 10 6 12 5 5 7 8 9 7 10 NA 11 7 3 NA 0.00 18 0.5731 0.5158
Khalil Ibrahim 7 12 9 NA 7 10 6 10 9 5 7 11 5 7 11 11 NA 9 3 NA 0.00 17 0.5697 0.4842
Kevin Green 9 12 9 9 8 9 7 NA NA 6 10 11 4 7 6 8 13 9 3 NA 0.00 17 0.5691 0.4837
Jamal Willis 8 10 NA NA NA NA NA 9 NA NA NA NA NA NA NA NA NA NA NA NA 0.00 3 0.5625 0.0844
Jason James 9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.00 1 0.5625 0.0281
TYREE BUNDY 8 8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 11 NA NA NA 0.00 3 0.5625 0.0844
Michael Beck 9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.00 1 0.5625 0.0281
Gregory Flint 6 11 NA 11 8 10 NA NA 9 5 8 NA 9 5 10 NA 10 NA 2 NA 0.00 13 0.5622 0.3654
Robert Lynch 9 9 6 10 10 6 4 9 10 5 9 8 7 6 12 10 11 8 4 NA 0.00 19 0.5543 0.5266
Trevor MACGAVIN 6 10 8 NA 6 7 4 NA 6 6 9 13 7 9 8 9 10 12 5 NA 0.00 17 0.5533 0.4703
THOMAS MCCOY 8 10 9 7 8 9 7 11 7 7 NA 10 5 8 NA 9 9 8 NA NA 0.00 16 0.5500 0.4400
DERRICK ELAM 6 9 11 10 10 7 NA 5 7 7 6 NA 7 9 NA 12 NA NA NA NA 0.00 13 0.5492 0.3570
Alexander Santillan 5 NA 8 9 5 11 6 11 8 9 7 9 8 8 NA NA NA NA NA NA 0.00 13 0.5474 0.3558
Derrick Zantt 11 6 7 NA 6 9 6 11 NA NA NA NA NA NA NA NA NA NA NA NA 0.00 7 0.5385 0.1885
Rodney Cathcart NA NA NA NA NA NA NA NA NA NA NA NA 7 NA NA NA NA NA NA NA 0.00 1 0.5385 0.0269
David Spielman 8 NA 11 NA NA NA 3 NA 7 8 9 NA NA NA NA 8 NA 8 NA NA 0.00 8 0.5299 0.2120
Craig Webster NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 8 NA NA 0.00 1 0.5000 0.0250
Edward Ford 6 8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.00 2 0.4375 0.0438

Individual Plots

Season Leaderboard

Season Leaderboard (Season Percent)
Week 20
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 David Plate 1 1 1.0000 0.0500
1 Pamela Augustine 1 1 1.0000 0.0500
3 Trevor Macgavin 0 1 0.7500 0.0375
4 Stephen Woolwine 2 13 0.6875 0.4469
5 Michael Edmunds 0 4 0.6774 0.1355
6 Justin Crick 0 20 0.6536 0.6536
7 Kevin O'NEILL 0 6 0.6522 0.1957
8 Shelly Bailey 2 11 0.6513 0.3582
9 William Schouviller 2 19 0.6479 0.6155
10 George Sweet 2 19 0.6477 0.6153
11 Ramar Williams 1 16 0.6409 0.5127
12 Chris Papageorge 1 15 0.6368 0.4776
13 Jason Schattel 1 19 0.6364 0.6046
14 Antonio Mitchell 1 17 0.6318 0.5370
15 Ryan Wiggins 0 18 0.6308 0.5677
16 Sarah Sweet 0 12 0.6307 0.3784
17 Anthony Bloss 2 20 0.6286 0.6286
17 Cheryl Brown 0 20 0.6286 0.6286
19 Daniel Halse 0 12 0.6278 0.3767
20 Carlos Caceres 0 1 0.6250 0.0312
21 Gabriel Quinones 1 17 0.6239 0.5303
22 Stephen Bush 1 19 0.6203 0.5893
23 Montee Brown 1 18 0.6200 0.5580
24 Patrick Tynan 2 19 0.6189 0.5880
25 Bradley Hobson 0 15 0.6186 0.4640
26 Vincent Scannelli 0 15 0.6169 0.4627
27 Shaun Dahl 2 16 0.6130 0.4904
28 Keithon Corpening 0 13 0.6129 0.3984
29 Cody Koerwitz 1 17 0.6121 0.5203
30 Brian Patterson 1 20 0.6107 0.6107
30 Ryan Cvik 1 20 0.6107 0.6107
32 DAVID PLATE 1 16 0.6104 0.4883
33 WAYNE SCHOFIELD 1 12 0.6102 0.3661
34 PABLO BURGOSRAMOS 2 19 0.6098 0.5793
35 John Plaster 1 18 0.6096 0.5486
36 James Tierney 2 19 0.6090 0.5786
37 Karen Coleman 3 19 0.6053 0.5750
38 Donald Park 0 8 0.6050 0.2420
39 Matthew Schultz 1 16 0.6037 0.4830
40 Eric Hahn 2 20 0.6036 0.6036
41 MICHAEL BRANSON 1 18 0.6008 0.5407
41 Michael Moss 0 18 0.6008 0.5407
43 Terry Hardison 0 20 0.6000 0.6000
44 Aubrey Conn 0 19 0.5985 0.5686
45 Paul Presti 1 17 0.5983 0.5086
46 Amy Asberry 0 20 0.5964 0.5964
46 James Small 1 20 0.5964 0.5964
48 Yiming Hu 0 17 0.5945 0.5053
49 James Blejski 1 15 0.5938 0.4454
49 Pamela AUGUSTINE 1 15 0.5938 0.4454
51 Paul Shim 1 20 0.5929 0.5929
52 Earl Dixon 0 17 0.5918 0.5030
53 Bunnaro Sun 0 19 0.5909 0.5614
53 Jonathon Leslein 1 19 0.5909 0.5614
55 Walter Archambo 0 19 0.5902 0.5607
56 Daniel Major 2 13 0.5896 0.3832
57 Daniel Baller 0 20 0.5893 0.5893
58 Ronald Schmidt 1 18 0.5887 0.5298
59 Brian Hollmann 2 20 0.5857 0.5857
59 Shawn Carden 1 20 0.5857 0.5857
61 Robert Gelo 0 16 0.5833 0.4666
62 William Sherman 0 8 0.5812 0.2325
63 Charlene Redmer 0 13 0.5806 0.3774
64 Kevin Kehoe 1 19 0.5805 0.5515
65 Brandon Parks 2 15 0.5804 0.4353
66 Steven Curtis 0 16 0.5787 0.4630
66 Thomas Brenstuhl 2 16 0.5787 0.4630
68 Rahmatullah Sharifi 0 7 0.5769 0.2019
69 Anthony Brinson 1 20 0.5750 0.5750
70 Manuel Vargas 0 18 0.5731 0.5158
71 Daniel Kuehl 0 19 0.5720 0.5434
72 Steven Webster 1 15 0.5714 0.4286
73 Khalil Ibrahim 0 17 0.5697 0.4842
74 Kevin Green 0 17 0.5691 0.4837
75 Jamal Willis 0 3 0.5625 0.0844
75 Jason James 0 1 0.5625 0.0281
75 Michael Beck 0 1 0.5625 0.0281
75 TYREE BUNDY 0 3 0.5625 0.0844
79 Gregory Flint 0 13 0.5622 0.3654
80 Kristen White 1 19 0.5606 0.5326
81 George Mancini 0 18 0.5605 0.5045
82 Min Choi 2 12 0.5570 0.3342
83 Robert Lynch 1 19 0.5543 0.5266
84 Trevor MACGAVIN 2 17 0.5533 0.4703
85 THOMAS MCCOY 0 16 0.5500 0.4400
86 DERRICK ELAM 2 13 0.5492 0.3570
87 Justin Thrift 0 18 0.5484 0.4936
88 Alexander Santillan 0 13 0.5474 0.3558
89 Rafael Torres 1 17 0.5447 0.4630
90 Derrick Elam 0 3 0.5385 0.0808
90 Derrick Zantt 0 7 0.5385 0.1885
90 Robert Martin 1 17 0.5385 0.4577
90 Rodney Cathcart 0 1 0.5385 0.0269
94 Cherylynn Vidal 0 17 0.5369 0.4564
95 David Spielman 0 8 0.5299 0.2120
96 Melissa Printup 1 16 0.5294 0.4235
97 Craig Webster 0 1 0.5000 0.0250
97 Wayne Schofield 0 2 0.5000 0.0500
99 Ryan Shipley 0 19 0.4848 0.4606
100 Edward Ford 0 2 0.4375 0.0438
101 Thomas Mccoy 0 2 0.4000 0.0400

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 20
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Justin Crick 0 20 0.6536 0.6536
2 Anthony Bloss 2 20 0.6286 0.6286
2 Cheryl Brown 0 20 0.6286 0.6286
4 William Schouviller 2 19 0.6479 0.6155
5 George Sweet 2 19 0.6477 0.6153
6 Brian Patterson 1 20 0.6107 0.6107
6 Ryan Cvik 1 20 0.6107 0.6107
8 Jason Schattel 1 19 0.6364 0.6046
9 Eric Hahn 2 20 0.6036 0.6036
10 Terry Hardison 0 20 0.6000 0.6000
11 Amy Asberry 0 20 0.5964 0.5964
11 James Small 1 20 0.5964 0.5964
13 Paul Shim 1 20 0.5929 0.5929
14 Daniel Baller 0 20 0.5893 0.5893
14 Stephen Bush 1 19 0.6203 0.5893
16 Patrick Tynan 2 19 0.6189 0.5880
17 Brian Hollmann 2 20 0.5857 0.5857
17 Shawn Carden 1 20 0.5857 0.5857
19 PABLO BURGOSRAMOS 2 19 0.6098 0.5793
20 James Tierney 2 19 0.6090 0.5786
21 Anthony Brinson 1 20 0.5750 0.5750
21 Karen Coleman 3 19 0.6053 0.5750
23 Aubrey Conn 0 19 0.5985 0.5686
24 Ryan Wiggins 0 18 0.6308 0.5677
25 Bunnaro Sun 0 19 0.5909 0.5614
25 Jonathon Leslein 1 19 0.5909 0.5614
27 Walter Archambo 0 19 0.5902 0.5607
28 Montee Brown 1 18 0.6200 0.5580
29 Kevin Kehoe 1 19 0.5805 0.5515
30 John Plaster 1 18 0.6096 0.5486
31 Daniel Kuehl 0 19 0.5720 0.5434
32 MICHAEL BRANSON 1 18 0.6008 0.5407
32 Michael Moss 0 18 0.6008 0.5407
34 Antonio Mitchell 1 17 0.6318 0.5370
35 Kristen White 1 19 0.5606 0.5326
36 Gabriel Quinones 1 17 0.6239 0.5303
37 Ronald Schmidt 1 18 0.5887 0.5298
38 Robert Lynch 1 19 0.5543 0.5266
39 Cody Koerwitz 1 17 0.6121 0.5203
40 Manuel Vargas 0 18 0.5731 0.5158
41 Ramar Williams 1 16 0.6409 0.5127
42 Paul Presti 1 17 0.5983 0.5086
43 Yiming Hu 0 17 0.5945 0.5053
44 George Mancini 0 18 0.5605 0.5045
45 Earl Dixon 0 17 0.5918 0.5030
46 Justin Thrift 0 18 0.5484 0.4936
47 Shaun Dahl 2 16 0.6130 0.4904
48 DAVID PLATE 1 16 0.6104 0.4883
49 Khalil Ibrahim 0 17 0.5697 0.4842
50 Kevin Green 0 17 0.5691 0.4837
51 Matthew Schultz 1 16 0.6037 0.4830
52 Chris Papageorge 1 15 0.6368 0.4776
53 Trevor MACGAVIN 2 17 0.5533 0.4703
54 Robert Gelo 0 16 0.5833 0.4666
55 Bradley Hobson 0 15 0.6186 0.4640
56 Rafael Torres 1 17 0.5447 0.4630
56 Steven Curtis 0 16 0.5787 0.4630
56 Thomas Brenstuhl 2 16 0.5787 0.4630
59 Vincent Scannelli 0 15 0.6169 0.4627
60 Ryan Shipley 0 19 0.4848 0.4606
61 Robert Martin 1 17 0.5385 0.4577
62 Cherylynn Vidal 0 17 0.5369 0.4564
63 Stephen Woolwine 2 13 0.6875 0.4469
64 James Blejski 1 15 0.5938 0.4454
64 Pamela AUGUSTINE 1 15 0.5938 0.4454
66 THOMAS MCCOY 0 16 0.5500 0.4400
67 Brandon Parks 2 15 0.5804 0.4353
68 Steven Webster 1 15 0.5714 0.4286
69 Melissa Printup 1 16 0.5294 0.4235
70 Keithon Corpening 0 13 0.6129 0.3984
71 Daniel Major 2 13 0.5896 0.3832
72 Sarah Sweet 0 12 0.6307 0.3784
73 Charlene Redmer 0 13 0.5806 0.3774
74 Daniel Halse 0 12 0.6278 0.3767
75 WAYNE SCHOFIELD 1 12 0.6102 0.3661
76 Gregory Flint 0 13 0.5622 0.3654
77 Shelly Bailey 2 11 0.6513 0.3582
78 DERRICK ELAM 2 13 0.5492 0.3570
79 Alexander Santillan 0 13 0.5474 0.3558
80 Min Choi 2 12 0.5570 0.3342
81 Donald Park 0 8 0.6050 0.2420
82 William Sherman 0 8 0.5812 0.2325
83 David Spielman 0 8 0.5299 0.2120
84 Rahmatullah Sharifi 0 7 0.5769 0.2019
85 Kevin O'NEILL 0 6 0.6522 0.1957
86 Derrick Zantt 0 7 0.5385 0.1885
87 Michael Edmunds 0 4 0.6774 0.1355
88 Jamal Willis 0 3 0.5625 0.0844
88 TYREE BUNDY 0 3 0.5625 0.0844
90 Derrick Elam 0 3 0.5385 0.0808
91 David Plate 1 1 1.0000 0.0500
91 Pamela Augustine 1 1 1.0000 0.0500
91 Wayne Schofield 0 2 0.5000 0.0500
94 Edward Ford 0 2 0.4375 0.0438
95 Thomas Mccoy 0 2 0.4000 0.0400
96 Trevor Macgavin 0 1 0.7500 0.0375
97 Carlos Caceres 0 1 0.6250 0.0312
98 Jason James 0 1 0.5625 0.0281
98 Michael Beck 0 1 0.5625 0.0281
100 Rodney Cathcart 0 1 0.5385 0.0269
101 Craig Webster 0 1 0.5000 0.0250

Data

---
title: "2023 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

```

```{r Reading in our picks files, include=FALSE}
current_week = 20 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2023 NFL Week 1.csv")
week_2 = read_csv("./CSV_Data_Files/2023 NFL Week 2.csv")
week_3 = read_csv("./CSV_Data_Files/2023 NFL Week 3.csv")
week_4 = read_csv("./CSV_Data_Files/2023 NFL Week 4.csv")
week_5 = read_csv("./CSV_Data_Files/2023 NFL Week 5.csv")
week_6 = read_csv("./CSV_Data_Files/2023 NFL Week 6.csv")
week_7 = read_csv("./CSV_Data_Files/2023 NFL Week 7.csv")
week_8 = read_csv("./CSV_Data_Files/2023 NFL Week 8.csv")
week_9 = read_csv("./CSV_Data_Files/2023 NFL Week 9.csv")
week_10 = read_csv("./CSV_Data_Files/2023 NFL Week 10.csv")
week_11 = read_csv("./CSV_Data_Files/2023 NFL Week 11.csv")
week_12 = read_csv("./CSV_Data_Files/2023 NFL Week 12.csv")
week_13 = read_csv("./CSV_Data_Files/2023 NFL Week 13.csv")
week_14 = read_csv("./CSV_Data_Files/2023 NFL Week 14.csv")
week_15 = read_csv("./CSV_Data_Files/2023 NFL Week 15.csv")
week_16 = read_csv("./CSV_Data_Files/2023 NFL Week 16.csv")
week_17 = read_csv("./CSV_Data_Files/2023 NFL Week 17.csv")
week_18 = read_csv("./CSV_Data_Files/2023 NFL Week 18.csv")
week_19 = read_csv("./CSV_Data_Files/2023 NFL Wild Card.csv")
week_20 = read_csv("./CSV_Data_Files/2023 NFL Divisional Round.csv")
# week_21 = read_csv("./CSV_Data_Files/2023 NFL Conference Round.csv")
# week_22 = read_csv("./CSV_Data_Files/2023 NFL Super Bowl.csv")

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2023 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7, week_8, week_9, week_10, week_11, week_12, week_13, week_14, week_15, week_16, week_17 , week_18, week_19 , week_20) #, week_21) #add in the additional weeks
# odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))

```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, echo=FALSE, out.width = "100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

### Individual Plots
```{r, out.width="100%"}
ggplotly(inst_indiv_plots)
```

### Season Leaderboard
```{r, out.width="100%"}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, out.width="100%"}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```